home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d2
/
stayres.arc
/
STAYSUBS.340
< prev
next >
Wrap
Text File
|
1988-06-27
|
4KB
|
111 lines
{****************************************************************************}
{ S T A Y S U B S . I N C }
{ }
{ Separate this file into "Staysubs.Inc" to provide Directory routines }
{ for the Stay-Resident Demo. }
{ }
{****************************************************************************}
{----------------------------------------------------------------------------}
{ F I L E S U B R O U T I N E S }
{----------------------------------------------------------------------------}
type
Dir_Entry = record
Reserved : array[1..21] of byte;
Attribute: byte;
Time, Date, FileSizeLo, FileSizeHi : integer;
Name : string[13];
end;
var
RetCode : byte;
Filename : filename_type;
Buffer : Dir_Entry;
Attribute : byte;
{----------------------------------------------------------------------------}
{ S E T Disk Transfer Address }
{----------------------------------------------------------------------------}
Procedure Disk_Trns_Addr(var Disk_Buf);
var
Registers : regtype;
Begin
with Registers do
begin
Ax := $1A shl 8; { Set disk transfer address to }
Ds := seg(Disk_Buf); { our disk buffer }
Dx := ofs(Disk_Buf);
msdos(Registers);
end;
end;
{----------------------------------------------------------------------------}
{ F I N D N E X T F I L E E N T R Y }
{----------------------------------------------------------------------------}
Procedure Find_Next(var Att:byte; var Filename : Filename_type;
var Next_RetCode : byte);
var
Registers : regtype;
Carry_flag : integer;
N : byte;
Begin {Find_Next}
Buffer.Name := ' '; { Clear result buffer }
with Registers do
begin
Ax := $4F shl 8; { Dos Find next function }
MsDos(Registers);
Att := Buffer.Attribute; { Set file attribute }
Carry_flag := 1 and Flags; { Isolate the Error flag }
Filename := ' ';
if Carry_flag = 1 then
Next_RetCode := Ax and $00FF
else
begin { Move file name }
Next_RetCode := 0;
for N := 0 to 12 do FileName[N+1] := Buffer.Name[N];
end;
end; {with}
end;
{----------------------------------------------------------------------------}
{ F I N D F I R S T F I L E F U N C T I O N }
{----------------------------------------------------------------------------}
Procedure Find_First (var Att: byte;
var Filename: Filename_type;
var RetCode_code : byte);
var
Registers :regtype;
Carry_flag :integer;
Mask, N :byte;
begin
Disk_Trns_Addr(buffer);
Filename[length(Filename) + 1] := chr(0);
Buffer.Name := ' ';
with Registers do
begin
Ax := $4E shl 8; { Dos Find First Function }
Cx := Att; { Attribute of file to fine }
Ds := seg(Filename); { Ds:Dx Asciiz string to find }
Dx := ofs(Filename) + 1;
MsDos(Registers);
Att := Buffer.Attribute; { set the file attribute byte }
{ If error occured set, Return code. }
Carry_flag := 1 and Flags; { If Carry flag, error occured }
{ and Ax will contain Return code }
if Carry_flag = 1 then
begin
RetCode_code := Ax and $00FF;
end
else
begin
RetCode_code := 0;
Filename := ' ';
for N := 0 to 12 do FileName[N+1] := Buffer.Name[N];
end;
end; {with}
end;